home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Purity / Purity #48 (1995-06-25)(PackMAN)(DE)[WB].zip / Purity #48 (1995-06-25)(PackMAN)(DE)[WB].adf / Grafik / tridemo.p < prev    next >
Text File  |  1995-06-24  |  3KB  |  129 lines
  1. program tridemo ( input, output ); {  jr/7sep87  }
  2. uses intuition,graphics;    {  aus modula2 umgesetzt (AMOK-Disk)  }
  3. const
  4.  WIDTH=320;
  5.  DEPTH=5;
  6.  POINTS=3;
  7.  
  8. var
  9.  scr: p_Screen;
  10.  rp: p_RastPort;
  11.  trp: ptr;
  12.  creg: integer;
  13.  MaxHeight: integer;
  14.  p: ptr;
  15.  
  16. type
  17.  VPoint=record
  18.   x, y, xv, yv: integer; {  position and velocity of point  }
  19.  end;
  20.  aofvpoint = array[0..points-1] of vpoint;
  21.  
  22. procedure MovePoint(var p: VPoint);
  23.  var n: integer;
  24.  begin
  25.   with p do begin
  26.    n:=x+xv;
  27.    if n>=WIDTH then begin                      {  Bounce from right side  }
  28.     xv:=-xv; x:=2*WIDTH-1-n
  29.    end else if n<0 then begin                        {  Bounce from left side  }
  30.     xv:=-xv; x:=-n
  31.    end
  32.    else begin
  33.     x:=n
  34.    end;
  35.  
  36.    n:=y+yv;
  37.    if n>=MaxHeight then begin                  {  Bounce from bottom side  }
  38.     yv:=-yv; y:=2*MaxHeight-1-n
  39.    end else if n<11 then begin                       {  Bounce from top side  }
  40.     yv:=-yv; y:=21-n
  41.    end
  42.    else begin
  43.     y:=n
  44.    end
  45.   end
  46.  end;
  47.  
  48.  
  49. procedure Show(var p: aofVPoint);
  50.  var i: integer; r:long;
  51.  begin
  52.   creg:=creg MOD 31+1; SetAPen(rp, creg);
  53.   r:=AreaMove(rp, p[0].x, p[0].y);
  54.   for i:=1 to POINTS-1 do begin
  55.    r:=AreaDraw(rp, p[i].x, p[i].y)
  56.   end;
  57.   r:=AreaEnd(rp)
  58.  end;
  59.  
  60.  
  61. procedure Demo;
  62.  var
  63.   i: integer;
  64.   pts: array [0..POINTS-1] of VPoint;
  65.   frames: integer;
  66.  begin
  67.   for i:=0 to POINTS-1 do begin
  68.    with pts[i] do begin
  69.     x:=RANDOM(WIDTH); y:=RANDOM(MaxHeight);
  70.     repeat xv:=RANDOM(16)-8 until xv<>0;
  71.     repeat yv:=RANDOM(16)-8 until yv<>0
  72.    end
  73.   end;
  74.  
  75.   for frames:=0 to 500 do begin
  76.    Show(pts);
  77.    for i:=0 to POINTS-1 do begin MovePoint(pts[i]) end
  78.   end
  79.  end;
  80.  
  81.  
  82. procedure InitColors;
  83.  var
  84.   i: integer;
  85.   vp: p_ViewPort;
  86.  begin
  87.   vp:=^scr^.viewPort;
  88.   for i:=0 to 7 do begin
  89.    SetRGB4(vp, i,    8,    0, 8+i );
  90.    SetRGB4(vp, i+8,  8+i,  0, 15  );
  91.    SetRGB4(vp, i+16, 15,   0, 15-i);
  92.    SetRGB4(vp, i+24, 15-i, 0, 8   )
  93.   end;
  94.   SetRGB4(vp, 0, 0, 0, 0)
  95.  end;
  96.  
  97.  
  98. procedure Cleanup;
  99. var bool: boolean;
  100.  begin
  101.   if trp<>nil then begin FreeRaster(trp, WIDTH, MaxHeight) end;
  102.   if scr<>nil then begin Close_Screen(scr) end
  103.  end;
  104.  
  105. var
  106.  ai: AreaInfo;
  107.  tr: TmpRas;
  108.  abuf: array [0..POINTS*5] of integer;
  109. begin
  110.  trp:=nil; scr:=nil;
  111.  scr:=Open_Screen(0,0,320, 256, 5,0,1,HAM,"TriDemo");
  112.  If scr=nil then ERROR('cannot open screen');
  113.  
  114.  MaxHeight:=scr^.height;
  115.  rp:=^scr^.rastPort;
  116.  InitColors;
  117.  
  118.  InitArea(^ai, ^abuf, SIZEOF(abuf) div 5);
  119.  trp:=AllocRaster(WIDTH, MaxHeight);
  120.  If trp=nil then ERROR('cannot alloc raster');
  121.  p:=InitTmpRas(^tr, trp, ((WIDTH+15) div 16) * MaxHeight);
  122.  rp^.areaInfo:=^ai;
  123.  rp^.tmpRas:=^tr;
  124.  
  125.  Demo;
  126.  Cleanup
  127. end.
  128.  
  129.